      SUBROUTINE SETUP
      RETURN
      END
C   HS105
C  SCALED X1'=X1 X2'=X2, X(I)'=X(I)/200,I=3,4,5, X(I)'=X(I)/25 I=6,7,8
C
      SUBROUTINE EF(X,FX)
      INCLUDE 'FUCO.INC'
      DOUBLE PRECISION X(NX),Y(235),CC,FX,TERM,A,B,C,ARG,S
      INTEGER I
      SAVE CC,Y
      DATA CC/2.236D0/
      DATA Y/.475D0,.525D0,4*.55D0,4*.575D0,15*.6D0,15*.625D0,
     1       15*.65D0,13*.675D0,21*.7D0,12*.725D0,17*.75D0,4*.775D0,
     2       20*.8D0,8*.825D0,17*.85D0,8*.875D0,6*.9D0,6*.925D0,
     3       7*.95D0,4*.975D0,3*1.D0,3*1.025D0,8*1.05D0, 1.075D0,6*1.1D0
     4      ,5*1.15D0,1.175D0,7*1.2D0,1.225D0,2*1.25D0/
      ICF=ICF+1
      S=0.D0
      DO      100      I=1,235
      TERM=(Y(I)-X(3))/X(6)
      A=0.D0
      IF(TERM .GE. CC)      GOTO  10
      A= X(1)*DEXP(-32.D0*TERM*TERM)/X(6)
  10  CONTINUE
      TERM=(Y(I)-X(4))/X(7)
      B=0.D0
      IF(TERM .GE. CC)      GOTO  20
      B= X(2)*DEXP(-32.D0*TERM*TERM)/X(7)
  20  CONTINUE
      TERM=(Y(I)-X(5))/X(8)
      C=0.D0
      IF(TERM .GE. CC)      GOTO  30
      C= (1.D0-X(1)-X(2))/X(8)*DEXP(-32.D0*TERM*TERM)
  30  CONTINUE
      ARG=A+B+C
      IF(ARG .LE. 0.D0)        S=S+328.D0
      IF(ARG .GT. 0.D0)        S=S-DLOG(ARG)
 100  CONTINUE
      FX=S
      RETURN
      END
      SUBROUTINE EGRADF(X,GRADF)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),GRADF(NX),Y(235),G(8),CC,D
      DOUBLE PRECISION X1,X2,X3,X4,X5,X6,X7,X8,YI,T1,T2,T3,A,B,C
      SAVE CC,Y
      DATA Y/.475D0,.525D0,4*.55D0,4*.575D0,15*.6D0,15*.625D0,
     1       15*.65D0,13*.675D0,21*.7D0,12*.725D0,17*.75D0,4*.775D0,
     2       20*.8D0,8*.825D0,17*.85D0,8*.875D0,6*.9D0,6*.925D0,
     3       7*.95D0,4*.975D0,3*1.D0,3*1.025D0,8*1.05D0, 1.075D0,6*1.1D0
     4      ,5*1.15D0,1.175D0,7*1.2D0,1.225D0,2*1.25D0/
      DATA  CC/2.236D0/
      ICGF=ICGF+1
      DO      100      I=1,8
      G(I)=0.D0
  100 CONTINUE
      X1=X(1)
      X2=X(2)
      X3=X(3)
      X4=X(4)
      X5=X(5)
      X6=X(6)
      X7=X(7)
      X8=X(8)
      DO      200      I=1,235
      YI=   Y(I)
      T1=(YI-X3)/X6
      A=0.D0
      IF(T1 .LT. CC)     A=DEXP(-32.D0*T1*T1)
      T2=(YI-X4)/X7
      B=0.D0
      IF(T2 .LT. CC)     B=DEXP(-32.D0*T2*T2)
      T3=(YI-X5)/X8
      C=0.D0
      IF(T3 .LT. CC)     C=DEXP(-32.D0*T3*T3)
      D=1.D0/(X1*A/X6+X2*B/X7+(1.D0-X1-X2)/X8*C)
      G(1)=G(1)-D* (A/X6 - C/X8)
      G(2)=G(2)-D* (B/X7 - C/X8)
      G(3)=G(3)-D* (X1*A*64.D0*T1/X6**2)
      G(4)=G(4)-D* (X2*B*64.D0*T2/X7**2)
      G(5)=G(5)-D* (1.D0-X1-X2)*C*64.D0*T3/X8**2
      G(6)=G(6)-D* X1*A/X6**2*(-1.D0 +64.D0*T1*T1)
      G(7)=G(7)-D* X2*B/X7**2*(-1.D0 +64.D0*T2*T2)
      G(8)=G(8)-D* (1.D0-X1-X2)*C/X8**2*(-1.D0 +64.D0*T3*T3)
  200 CONTINUE
      DO      300      I=1,8
      GRADF(I)=G(I)
  300 CONTINUE
      RETURN
      END
      SUBROUTINE EH(I,X,HXI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),HXI
      CRES(I)=CRES(I)+1
      RETURN
      END
      SUBROUTINE EGRADH(I,X,GRADHI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),GRADHI(NX)
      CGRES(I)=CGRES(I)+1
      RETURN
      END
      SUBROUTINE EG(I,X,GXI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),UG(8),OG(8),GXI
      SAVE UG,OG
      DATA UG/2*1.D-3,.5D0,.65D0,.85D0,3*.2D0/
      DATA OG/2*.499D0,.9D0,1.05D0,1.2D0,3*1.D0/
      IF ( GUNIT(1,I+NH) .EQ. -1 )CRES(I+NH)=CRES(I+NH)+1
      IF(I .GT. 1)      GOTO 100
      GXI=1.D0-X(1)-X(2)
      RETURN
  100 CONTINUE
      IF(I .LE.  9)      GXI=X(I-1)-UG(I-1)
      IF(I .GT.  9)      GXI=OG(I-9)-X(I-9)
      RETURN
      END
      SUBROUTINE EGRADG(I,X,GRADGI)
      INCLUDE 'FUCO.INC'
      INTEGER I,J
      DOUBLE PRECISION X(NX) ,GRADGI(NX)
      IF ( GUNIT(1,I+NH) .EQ. 1 ) RETURN 
      CGRES(I+NH)=CGRES(I+NH)+1
      GRADGI(1)=-1.D0
      GRADGI(2)=-1.D0
      DO J=3,8
        GRADGI(J)=0.D0 
      ENDDO
      RETURN
      END
      BLOCK DATA
      INCLUDE 'BLOCO.INC'
      INTEGER I,J
      DATA NAME/'HS105SCA'/
      DATA (X(I),I=1,8)
     F    /.1D0,.2D0,.5D0,.625D0,.875D0,.448D0,.528D0,.632D0/
      DATA N/ 8/ , NH/0/ , NG/17/
      DATA DEL0/0.01D0/ ,TAU0/1.D0/ ,TAU/.1D0/
      DATA ((GUNIT(I,J),I=1,3),J=0,1)/-1,0,0,-1,0,0/,
     F     (GUNIT(1,J),J=2,17)/16*1/,(GUNIT(2,J),J=2,17)/1,2,3,4,5,
     F     6,7,8,1,2,3,4,5,6,7,8/,(GUNIT(3,J),J=2,17)/8*1,8*-1/     
      END
